home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / source / obrn-a_1.5_src.lha / oberon-a / source3.lha / Source / OD / OD.mod next >
Encoding:
Text File  |  1995-01-26  |  8.7 KB  |  358 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: OD.mod $
  4.   Description: The Oberon-A module definition utility
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.7 $
  8.       $Author: fjc $
  9.         $Date: 1995/01/26 02:00:59 $
  10.  
  11.   Copyright © 1994-1995, Frank Copeland
  12.   This module forms part of Oberon-A
  13.   See Oberon-A.doc for conditions of use and distribution
  14.  
  15.   Log entries are at the end of the file.
  16.  
  17. *************************************************************************)
  18.  
  19. <* STANDARD- *>
  20.  
  21. MODULE OD;
  22.  
  23. IMPORT
  24.   SYS := SYSTEM, Kernel, ODRev, Errors, e := Exec, d := Dos,
  25.   du := DosUtil, str := Strings, s := ODStrings, u := Utility,
  26.   wb := Workbench, i := Icon, WbConsole, ODT;
  27.  
  28. CONST
  29.   CopyrightStr = "Copyright © 1994-1995 Frank Copeland\n";
  30.   maxPath   = 255;
  31.  
  32. TYPE
  33.   PathStr = ARRAY maxPath + 1 OF CHAR;
  34.  
  35. VAR
  36.   startDir : d.FileLockPtr;
  37.   progName : PathStr;
  38.  
  39.  
  40. (*
  41. ** Command line template and parsing
  42. *)
  43.  
  44. CONST
  45.   template =
  46.     "FILE/A,MAKEICONS/S,NOICONS/S,"
  47.     "TO/K,EXTERNAL/S,SIZE/S,EXPAND/S";
  48.  
  49.   helpStr =
  50.     "See OD.doc for more details\n\n"
  51.     "Arguments ? ";
  52.  
  53.   optFILE      = 0;
  54.   optMAKEICONS = 1;
  55.   optNOICONS   = 2;
  56.   optTO        = 3;
  57.   optEXTERNAL  = 4;
  58.   optSIZE      = 5;
  59.   optEXPAND    = 6;
  60.   optCount     = 7;
  61.  
  62. VAR
  63.   rdArgs : d.RDArgsPtr;
  64.   args : ARRAY optCount OF SYS.LONGWORD;
  65.  
  66. (* These are filled in by ParseArgs() *)
  67.  
  68. VAR
  69.   pattern, toDir : e.LSTRPTR;
  70.   MakeIcons : BOOLEAN;
  71.  
  72.  
  73. (*
  74. ** Icon types
  75. *)
  76.  
  77. CONST
  78.   iconFile = 0;
  79.  
  80.  
  81. (*
  82. ** Console I/O
  83. *)
  84.  
  85. (*------------------------------------*)
  86. PROCEDURE OutStr ( string : ARRAY OF CHAR );
  87. <*$CopyArrays-*>
  88. BEGIN (* OutStr *)
  89.   du.HaltIfBreak ({d.ctrlC});
  90.   IF d.PutStr (string) = 0 THEN END;
  91. END OutStr;
  92.  
  93.  
  94. (*------------------------------------*)
  95. PROCEDURE OutChar ( c : CHAR );
  96. BEGIN (* OutChar *)
  97.   du.HaltIfBreak ({d.ctrlC});
  98.   d.PrintF ("%lc", c)
  99. END OutChar;
  100.  
  101.  
  102. (*------------------------------------*)
  103. PROCEDURE OutLn;
  104. BEGIN (* OutLn *)
  105.   OutChar ("\n")
  106. END OutLn;
  107.  
  108.  
  109. (*------------------------------------*)
  110. PROCEDURE OutStr0 ( n : LONGINT );
  111.   VAR string : e.LSTRPTR;
  112. BEGIN (* OutStr0 *)
  113.   du.HaltIfBreak ({d.ctrlC});
  114.   string := s.GetString (n);
  115.   IF d.PutStr (string^) = 0 THEN END;
  116. END OutStr0;
  117.  
  118.  
  119. (*------------------------------------*)
  120. PROCEDURE OutStr1 ( n : LONGINT; string : ARRAY OF CHAR );
  121.   VAR format : e.LSTRPTR;
  122. <*$CopyArrays-*>
  123. BEGIN (* OutStr1 *)
  124.   du.HaltIfBreak ({d.ctrlC});
  125.   format := s.GetString (n);
  126.   d.PrintF (format^, SYS.ADR (string));
  127. END OutStr1;
  128.  
  129.  
  130. (*------------------------------------*)
  131. PROCEDURE OutBool ( b : BOOLEAN );
  132. BEGIN (* OutBool *)
  133.   IF b THEN OutStr ("TRUE")
  134.   ELSE OutStr ("FALSE")
  135.   END
  136. END OutBool;
  137.  
  138.  
  139. (*------------------------------------*)
  140. PROCEDURE* Cleanup (VAR rc : LONGINT);
  141.   VAR oldDir : d.FileLockPtr;
  142. BEGIN (* Cleanup *)
  143.   IF rdArgs # NIL THEN
  144.     d.FreeArgs (rdArgs);
  145.     d.FreeDosObject (d.rdArgs, rdArgs);
  146.     rdArgs := NIL
  147.   END;
  148.   s.CloseCatalog();
  149.   IF Kernel.fromWorkbench THEN oldDir := d.CurrentDir (startDir) END
  150. END Cleanup;
  151.  
  152. (*------------------------------------*)
  153. PROCEDURE Init ();
  154.  
  155. BEGIN (* Init *)
  156.   Kernel.SetCleanup (Cleanup);
  157.   s.OpenCatalog (NIL, "");
  158.   rdArgs := d.AllocDosObjectTags (d.rdArgs, u.end);
  159.   rdArgs.extHelp := SYS.ADR (helpStr);
  160. END Init;
  161.  
  162. (*------------------------------------*)
  163. PROCEDURE CloneStr ( oldStr : e.LSTRPTR ) : e.LSTRPTR;
  164.   VAR newStr : e.LSTRPTR;
  165. BEGIN (* CloneStr *)
  166.   SYS.NEW (newStr, str.Length (oldStr^) + 1);
  167.   COPY (oldStr^, newStr^);
  168.   RETURN newStr
  169. END CloneStr;
  170.  
  171. (*------------------------------------*)
  172. PROCEDURE ParseArgs ();
  173.  
  174.   VAR
  175.     string : e.LSTRPTR; ignore : BOOLEAN;
  176.     makeicons, noicons : BOOLEAN;
  177.  
  178. BEGIN (* ParseArgs *)
  179.   pattern := SYS.VAL (e.LSTRPTR, args [optFILE]);
  180.  
  181.   makeicons := (SYS.VAL (LONGINT, args [optMAKEICONS]) # 0);
  182.   noicons := (SYS.VAL (LONGINT, args [optNOICONS]) # 0);
  183.   IF makeicons & noicons THEN OutStr0 (s.errMakeIcons); HALT (d.warn)
  184.   ELSIF makeicons THEN MakeIcons := TRUE
  185.   ELSIF noicons THEN MakeIcons := FALSE
  186.   END;
  187.  
  188.   toDir := SYS.VAL (e.LSTRPTR, args [optTO]);
  189.   ODT.external := (SYS.VAL (LONGINT, args [optEXTERNAL]) # 0);
  190.   ODT.size := (SYS.VAL (LONGINT, args [optSIZE]) # 0);
  191.   ODT.expand := (SYS.VAL (LONGINT, args [optEXPAND]) # 0);
  192. END ParseArgs;
  193.  
  194. (*------------------------------------*)
  195. PROCEDURE MakeIcon ( file : ARRAY OF CHAR );
  196.  
  197.   VAR
  198.     icon : PathStr;
  199.     diskObj : wb.DiskObjectPtr;
  200.  
  201. <*$CopyArrays-*>
  202. BEGIN (* MakeIcon *)
  203.   IF MakeIcons THEN
  204.     ASSERT (i.base # NIL, 100);
  205.     COPY (file, icon); str.Append (".info", icon);
  206.     IF ~du.FileExists (icon) THEN
  207.       diskObj := i.GetDiskObject ("ENV:OD/def_file");
  208.       IF diskObj = NIL THEN diskObj := i.GetDefDiskObject (wb.project) END;
  209.       IF diskObj # NIL THEN
  210.         diskObj.currentX := wb.noIconPosition;
  211.         diskObj.currentY := wb.noIconPosition;
  212.         IF ~i.PutDiskObject (file, diskObj) THEN
  213.           IF d.PrintFault (d.IoErr(), "PutDiskObject") THEN END;
  214.           OutStr1 (s.errIcon1, file)
  215.         END;
  216.         i.FreeDiskObject (diskObj)
  217.       ELSE
  218.         IF d.PrintFault (d.IoErr(), "GetDiskObject") THEN END;
  219.         OutStr0 (s.errIcon2)
  220.       END
  221.     END
  222.   END
  223. END MakeIcon;
  224.  
  225.  
  226. (*------------------------------------*)
  227. PROCEDURE Main ();
  228.  
  229.   VAR
  230.     myAnchor  : d.AnchorPathPtr;
  231.     result    : LONGINT;
  232.  
  233.   (*------------------------------------*)
  234.   PROCEDURE WbArgs ();
  235.  
  236.     VAR
  237.       wbStartup : wb.WBStartupPtr;
  238.       numArgs   : LONGINT;
  239.       argList   : wb.WBArgumentsPtr;
  240.       oldDir    : d.FileLockPtr;
  241.       diskObj   : wb.DiskObjectPtr;
  242.       toolTypes : wb.ToolTypePtr;
  243.       string    : e.LSTRPTR;
  244.  
  245.   BEGIN (* WbArgs *)
  246.     ASSERT (i.base # NIL, 100);
  247.  
  248.     wbStartup := SYS.VAL (wb.WBStartupPtr, Kernel.WBenchMsg);
  249.     numArgs := wbStartup.numArgs;
  250.     argList := wbStartup.argList;
  251.     IF numArgs > 2 THEN OutStr0 (s.errArgs1); HALT (d.warn) END;
  252.  
  253.     COPY (argList [0].name^, progName);
  254.     startDir := d.CurrentDir (argList[0].lock);
  255.  
  256.     diskObj := i.GetDiskObject (progName);
  257.     IF diskObj # NIL THEN
  258.       toolTypes := diskObj.toolTypes;
  259.  
  260.       string := i.FindToolType (toolTypes, "FILE");
  261.       IF string # NIL THEN args [optFILE] := CloneStr (string) END;
  262.       string := i.FindToolType (toolTypes, "MAKEICONS");
  263.       IF string # NIL THEN args [optMAKEICONS] := TRUE END;
  264.       string := i.FindToolType (toolTypes, "NOICONS");
  265.       IF string # NIL THEN args [optNOICONS] := TRUE END;
  266.       string := i.FindToolType (toolTypes, "TO");
  267.       IF string # NIL THEN args [optTO] := CloneStr (string) END;
  268.       string := i.FindToolType (toolTypes, "SIZE");
  269.       IF string # NIL THEN args [optSIZE] := TRUE END;
  270.       string := i.FindToolType (toolTypes, "EXTERNAL");
  271.       IF string # NIL THEN args [optEXTERNAL] := TRUE END;
  272.       string := i.FindToolType (toolTypes, "EXPAND");
  273.       IF string # NIL THEN args [optEXPAND] := TRUE END;
  274.  
  275.       i.FreeDiskObject (diskObj)
  276.     END;
  277.  
  278.     oldDir := d.CurrentDir (argList[numArgs-1].lock);
  279.     IF SYS.VAL (LONGINT, args [optFILE]) = 0 THEN
  280.       IF numArgs = 2 THEN args [optFILE] := argList[numArgs-1].name
  281.       ELSE OutStr0 (s.errArgs2); HALT (d.warn)
  282.       END
  283.     END
  284.   END WbArgs;
  285.  
  286.  
  287.   (*------------------------------------*)
  288.   PROCEDURE ShellArgs ();
  289.   BEGIN (* ShellArgs *)
  290.     ASSERT (d.GetProgramName (progName, LEN (progName)));
  291.     IF d.OldReadArgs (template, args, rdArgs) = NIL THEN
  292.       ASSERT (d.PrintFault (d.IoErr(), "ReadArgs"));
  293.       HALT (d.warn)
  294.     END
  295.   END ShellArgs;
  296.  
  297.  
  298.   (*------------------------------------*)
  299.   PROCEDURE Process ( file : ARRAY OF CHAR );
  300.     VAR modName : ARRAY 32 OF CHAR; fileName : ARRAY 256 OF CHAR;
  301.   <*$CopyArrays-*>
  302.   BEGIN (* Process *)
  303.     ODT.Init ();
  304.     IF ODT.Import (file, modName) THEN
  305.       IF toDir # NIL THEN COPY (toDir^, fileName)
  306.       ELSE fileName := ""
  307.       END;
  308.       IF d.AddPart (fileName, modName, LEN (fileName)) THEN
  309.         str.Append (".Def", fileName);
  310.         ODT.Export (fileName, modName);
  311.         MakeIcon (fileName)
  312.       ELSE
  313.         OutStr0 (s.errFileName); HALT (d.error)
  314.       END;
  315.     ELSE
  316.       HALT (d.error)
  317.     END;
  318.     ODT.Close ();
  319.     Kernel.GC
  320.   END Process;
  321.  
  322.  
  323. BEGIN (* Main *)
  324.   OutStr (ODRev.vString);
  325.   OutStr (CopyrightStr);
  326.   OutStr0 (s.usage);
  327.   OutLn;
  328.  
  329.   IF Kernel.fromWorkbench THEN WbArgs()
  330.   ELSE ShellArgs()
  331.   END;
  332.   ParseArgs();
  333.  
  334.   NEW (myAnchor); myAnchor.strlen := SHORT (LEN (myAnchor.buf));
  335.   result := d.MatchFirst (pattern^, myAnchor^);
  336.   WHILE result = 0 DO
  337.     Process (myAnchor.buf);
  338.     result := d.MatchNext (myAnchor^)
  339.   END;
  340.   d.MatchEnd (myAnchor^)
  341. END Main;
  342.  
  343. BEGIN (* OD *)
  344.   ASSERT (e.SysBase.libNode.version >= 37);
  345.   Errors.Init;
  346.  
  347.   Init ();
  348.   Main ()
  349. END OD.
  350.  
  351. (***************************************************************************
  352.  
  353.   $Log: OD.mod $
  354.   Revision 1.7  1995/01/26  02:00:59  fjc
  355.   - Release 1.5
  356.  
  357. ***************************************************************************)
  358.